home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr13 / golisp.zip / LEAD.LSP < prev    next >
Text File  |  1995-01-20  |  2KB  |  52 lines
  1. ;Draws a leader line and allows entry of multiple lines of text
  2. ;Bob Zelna
  3.  
  4. (DEFUN C:LEAD (/ ?m@ ?ml ?m& ?m1 ?m0 ENT SS N
  5.                  SIDE? FIRSTPT SECNDPT INSRTPT CONSTT)
  6.   (SETQ SS (SSADD))
  7.   (SETQ ?m@(GETPOINT"\nLeader start: ")
  8.         ?ml(GETPOINT ?m@"\nTo point: ")
  9.         ?m1(*(GETVAR"DIMSCALE")(GETVAR"DIMASZ"))
  10.         *NL* 1
  11.   )
  12.   (IF(>=(DISTANCE ?m@ ?ml)(* 2.0(GETVAR"DIMASZ")))
  13.     (PROGN
  14.       (COMMAND"INSERT""*ARROW"?m@ ?m1 (+(/(* (ANGLE ?m@ ?ml)180.0)PI)180.0))
  15.       (SETQ ENT (ENTLAST))
  16.       (COMMAND "CHANGE" ENT "" "P" "LAYER" "D" "")
  17.       (SSADD ENT SS)
  18.     )
  19.   )
  20.   (COMMAND"LINE"?m@ ?ml"")
  21.   (SETQ ENT (ENTLAST))
  22.   (SSADD ENT SS)
  23.   (WHILE(/=(SETQ ?m&(GETPOINT ?ml"\nTo point: "))NIL)
  24.     (COMMAND"LINE"?ml ?m&"")
  25.     (SETQ *NL*(1+ *NL*)
  26.           FIRSTPT ?ml
  27.           SECNDPT ?m&
  28.           ?ml ?m&
  29.     )
  30.   )
  31.   (SETQ CONSTT (* (GETVAR"DIMSCALE")(GETVAR"DIMTXT"))
  32.         SECNDPT (REVERSE (LIST (- (CADR SECNDPT)(* CONSTT 0.5))
  33.                                (CAR SECNDPT)
  34.                          )
  35.                 )
  36.   )
  37.   (COND ((> (CAR FIRSTPT)(CAR SECNDPT))
  38.         (SETQ INSRTPT (CONS (- (CAR SECNDPT) (* CONSTT (/ 2.0 3)))
  39.                             (CDR SECNDPT))
  40.               SIDE? "R")
  41.         )
  42.         ((< (CAR FIRSTPT)(CAR SECNDPT))
  43.         (SETQ INSRTPT (CONS (+ (CAR SECNDPT) (* CONSTT (/ 2.0 3)))
  44.                       (CDR SECNDPT)))
  45.         (SETQ SIDE? "L"))
  46.   )
  47.   (IF (= SIDE? "L")
  48.     (COMMAND "DTEXT" INSRTPT CONSTT "0")
  49.     (COMMAND "DTEXT" SIDE? INSRTPT CONSTT "0")
  50.   )
  51. )
  52.